perm filename RESPC.F4[NEW,LCS]7 blob sn#326579 filedate 1978-01-02 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400		1 RCLEF(0/7) /IVV/IV(1)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200		INTEGER DUMMY
01300		COMMON /PX/PN(1) /Q/Q(1)
01400		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500		1 /KBAR/KBAR(1) /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
01600		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400		1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
02600	
02700		IF(NMPG.NE.'PAGEA')GO TO 2000
02800	CC	NPZ='PAGEZ'
02900	CC	NPZF='PAGFZ'
03000	CC	NPZG='PAGGZ'
03100	C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
03200		RNEXT=0
03300	2000	SPCNT=1.0
03400		JX=0
03500		JCEN=0
03600	C  FLAG FOR CENTERED RESTS.
03700		XT=0
03800		PX=0
03900		CALL SHFT1(KQ)
04000		KK=L
04100	CC	TYPE 3001,L
04200	C  DELETES EXTRA BAR LINES, ETC.
04300		IF(IPG)CALL RESTS
04400	C???	IF(N)RETURN 
04500	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04600	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04700		CALL SHIFT
04800	C  L=NUMBER OF ITEMS FOR RHY RECONS.
04900		JJ2=L+2
05000	C FOR WDCNT IN .PAG FILE
05100		N=0
05200		S=-100
05300		R=0
05400		KCLEF=0
05500		NOGRCE=-1
05600	C  GRACE NOTE FLAG
05700	
05800		DO 601 K=1,L
05900		R=CODEN(KPN,K,Q,J)
06000		RZ=Q(J)
06100	CX	J=KPN(K)
06200	CC	N=N+1
06300	CC	NN(N)=0
06400	CC	MM(N)=J+3
06500		CALL MMNN(3)
06600	CX	R=Q(J+1)
06700	801	IF(R.NE.1)GO TO 2801
06800		IF(RZ.LT.7)GO TO 601
06900		IF(Q(J+9).GT..05)GO TO 702
07000		IF(Q(J+9).EQ.0)GO TO 601
07100	CC	IF(Q(J+8).EQ.1000)GO TO 601
07200	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
07300		NOGRCE=0
07400		GO TO 601
07500	2801	IF(R.NE.2)GO TO 1801
07600		IF(RZ.LT.5)GO TO 601
07700		IF(IPG)GO TO 1801
07800		IF(RZ.LT.6)GO TO 1801
07900		RS=Q(J+3)
08000	C GET POS. OF CENTERED WHOLE REST
08100		TT=0
08200		B=Q(J+2)
08300	C GET THE STAFF NUM.
08400		DO 602 M=1,L
08500		T=CODEN(KPN,M,Q,JJ)
08600		A=Q(JJ+3)
08700	C GET POS. OF ITEM
08800		IF(A.GT.RS)GO TO 602
08900	C JUMP IF ITEM IS TO RIGHT OF REST
09000		IF(T.NE.4)GO TO 602
09100	C IS THE ITEM A BAR LINE
09200		IF(A.GT.TT)TT=A
09300	C FINDS BAR LINE CLOSEST TO LEFT OF REST
09400	602	CONTINUE
09500	C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
09600		T=20000
09700		A=20000
09800	C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
09900		DO 613 M=1,L
10000		IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
10100		IF(Q(JJ).LT.7)GO TO 609
10200	C SKIP IF RHYTH NOT IN P9
10300		IF(Q(JJ+9).LT..05)GO TO 613
10400	C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
10500	609	B=Q(JJ+3)
10600	C POS. OF ITEM
10700		X=B-TT
10800		IF(X)GO TO 613
10900	C JUMP IF ITEM IS TOO FAR TO LEFT
11000		IF(X.GT.A)GO TO 613
11100		A=X
11200		T=B
11300	C T = POS OF NOTE OR REST NEAREST BAR, ETC.
11400	613	CONTINUE
11500		IF(T.NE.20000)GO TO 612
11600	C JUMP IF NOTE OR REST FOUND
11700		JCEN=-1
11800		GO TO 1801
11900	612	Q(J+3)=T
12000	C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
12100	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
12200	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
12300	1801	IF(R.LT.4)GO TO 702
12400		IF(R.EQ.17)GO TO 1702
12500		IF(R.EQ.18)GO TO 1702
12600		IF(R.LE.7)GO TO 30
12700		IF(R.NE.44)GO TO 601
12800		IF(RZ.EQ.2)GO TO 601
12900	C RZ=2= BAR LINE ON UPPER STAFF
13000		IF(Q(J+6).EQ.0)GO TO 601
13100		IF(Q(J+5).EQ.0)GO TO 601
13200	C  GETS LEFT END OF LINES, CRESC., DASHES.
13300		GO TO 604
13400	30	IF(R.NE.7)GO TO 605
13500		IF(RZ.LT.5)GO TO 604
13600	C JUMP FOR STANDARD TRILL
13700		RS=Q(J+7)
13800		IF(RS.EQ.1)GO TO 604
13900		IF(ABS(RS).GE.3)GO TO 604
14000	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
14100		GO TO 601
14200	605	IF(R.NE.4)GO TO 604
14300		IF(RZ.LE.3)GO TO 702
14400	C JUMP IF IT IS A BAR LINE
14500	CC	IF(RZ.LT.4)GO TO 601
14600		IF(Q(J+6).NE.0)GO TO 604
14700	C GO GET OTHER POS OF LINE
14800		GO TO 601
14900	1702	IF(Q(J+4).NE.0)GO TO 601
15000		IF(Q(J+2).NE.0)GO TO 601
15100	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
15200	702	NN(N)=R 
15300		GO TO 601
15400	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
15500	604	CALL MMNN(6)
15600	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
15700		IF(R.NE.6)GO TO 601
15800	C NEXT FOR BEAMS
15900		IF(RZ.LT.8)GO TO 608
16000		IF(Q(J+10).EQ.0)GO TO 608
16100		IF(Q(J+8))GO TO 608
16200	C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
16300		IF(Q(J+7).GT.0)CALL MMNN(8)
16400	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
16500	608	IF(RZ.LT.7)GO TO 601
16600		IF(Q(J+7))GO TO 688
16700	C  P7 IS NEG FOR TREMOLO
16800		IF(Q(J+8).EQ.0)GO TO 601
16900	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
17000	688	IF(Q(J+9).GT.0)CALL MMNN(9)
17100	C FOUND A POS. IN P9
17200	601	CONTINUE
17300	
17400	C NEXT SORTS THE POINTS
17500	6000	J=1
17600	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
17700		CALL EXCHG(MM(J),NN(J))
17800	C  ABOVE EXCHGS --(J) AND --(J+1)
17900		IF(J.EQ.1)GO TO 710
18000		J=J-1
18100		GO TO 610
18200	710	J=J+1
18300		IF(J.LT.N)GO TO 610
18400	C NOW ALL SORTED
18500		CALL FNDEND(R)
18600		CALL SHFTQ(R)
18700	C  SHIFTS TO PROPER HORIZ. POS.
18800		IF(IPG)CALL RESTP
18900	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
19000		IF(N.LE.0)GO TO 122
19100	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
19200	
19300		DO 119 K=1,150
19400	119	HH(K)=0
19500	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
19600		G(1)=0
19700		E(1)=0
19800		F(1)=0
19900		RN(1500)=0
20000		RN(2500)=0
20100		ST=0
20200	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
20300	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
20400		KE=0
20500		J=1000
20600	933	JJ=1500
20700		JJJ=2000
20800		T=0
20900		M=0
21000		A=0
21100		B=0
21200	
21300		DO 33 K=1,N
21400		IF(NORH(KK))GO TO 33
21500	CC	KK=NN(K)
21600	CC	IF(KK.EQ.0)GO TO 33
21700	CC	IF(KK.EQ.4)GO TO 2133
21800	CC	IF(KK.EQ.17)GO TO 2133
21900	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
22000	CC	IF(KK.EQ.18)GO TO 2133
22100	CC	IF(KK.GT.2)GO TO 33
22200	2133	LL=MM(K)-3
22300		IF(KK.LE.2)GO TO 1133
22400		RH=.01
22500	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
22600	CCC	IF(KK.NE.4)RH=.6
22700		GO TO 3133
22800	1133	IF(Q(LL+2).NE.ST)GO TO 33
22900	C JUMP IF NOT ON RIGHT STAFF
23000		RA=9
23100		IF(KK.EQ.2)RA=7
23200		IF(Q(LL).LT.RA-2)GO TO 33
23300	C JUMP IF WDCNT IS TOO SHORT
23400		RH=Q(LL+IFIX(RA))
23500		IF(RH.EQ.0)GO TO 33
23600	3133	RZ=Q(LL+3)
23700		IF(ZERO(RZ,A).EQ.0)GO TO 133
23800	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
23900		RRH=RH
24000	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
24100		TT=T
24200	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
24300		J=J+1
24400	C UPDATE COUNTER IN POSITION ARRAY
24500		T=T+RH
24600	C ADD TO TOTAL RHYTHM
24700		RN(J)=T
24800		A=Q(LL+3)
24900	C SAVE POS. OF THIS NOTE.
25000		GO TO 33
25100	133	IF(RH.EQ.RHH)GO TO 33
25200	C  IGNORE 2ND RHYTH IF SAME AS FIRST
25300		IF(ZERO(RZ,B).EQ.0)GO TO 333
25400	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
25500		TTT=TT
25600	C SAVE TOTAL RHYTHM TO THIS POINT.
25700		TT=TT+RH
25800		JJ=JJ+1
25900	C UPDATE COUNTER FOR 2ND ARRAY
26000		RN(JJ)=TT
26100		RRRH=RH
26200		B=A
26300		GO TO 33
26400	333	IF(RH.EQ.RRRH)GO TO 33
26500		TTT=TTT+RH
26600		JJJ=JJJ+1
26700		RN(JJJ)=TTT
26800	33	CONTINUE
26900	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
27000		IF(ST.NE.0)GO TO 733
27100		KE=J-999
27200	C TOTAL NUM OF RHYTHMS ON STAFF1.
27300	CC	IF(JPG.EQ.0)GO TO 2233
27400		IF(JPG.LE.1)GO TO 2233
27500	C JPG=0=PARTS;    =1=PAGE, 1 STAFF
27600	C  JUMP IF ONLY ONE STAFF
27700	C****733	KF=J-2499
27800	C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
27900	733	ST=ST+1
28000		IF(ST.GT.1)GO TO 833
28100	C JUMP IF ALL STAVES HAVE BEEN READ.
28200	1233	J=2500
28300		GO TO 933
28400	833	IF(J.NE.2500)GO TO 1533
28500	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
28600	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
28700	
28800	2233	CALL RLOOP(HH,E,KE)
28900	C FOR SINGLE STAFF OF RHYTHM
29000		KL=KE
29100		GO TO 1333
29200	1533	K=1
29300		L=1
29400		M=0
29500	19	KK=K
29600		LL=L
29700	1	SM=10000
29800		K=K+1
29900		IF(K.GT.KE)GO TO 10
30000	4	L=L+1
30100		Y=F(L)
30200		B=Y-F(L-1)
30300		IF(B.LT.SM)SM=B
30400	2	X=E(K)
30500		A=X-E(K-1)
30600	C  A AND B HAVE TRUE DURATIONS NOW
30700		IF(A.LT.SM)SM=A
30800	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
30900		IF(ZERO(X,Y).EQ.0)GO TO 3
31000	C JUMP IF EQUAL RHYTHS
31100		IF(X.GT.Y)GO TO 4
31200		K=K+1
31300	C STEP FORWARD UNTIL X IS .GT. Y
31400		GO TO 2
31500	3	IF(K.NE.KK+1)GO TO 13
31600		IF(L.NE.LL+1)GO TO 14
31700		M=M+1
31800		G(M)=E(KK)
31900		GO TO 19
32000	13	IF(L.NE.LL+1)GO TO 15
32100		DO 16 J=KK,K-1
32200		M=M+1
32300	16	G(M)=E(J)
32400		GO TO 19
32500	14	DO 17 J=LL,L-1
32600		M=M+1
32700	17	G(M)=F(J)
32800		GO TO 19
32900	15	XM=SM-.001
33000		M=M+1
33100		P=E(KK)
33200		G(M)=P
33300	7	KK=KK+1
33400		LL=LL+1
33500		YM=SM*1.5
33600	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
33700		S=P
33800		T=P
33900	27	A=E(KK)
34000		B=F(LL)
34100		IF(ZERO(A,B).EQ.0)GO TO 19
34200		X=ZERO(A,P)
34300		Y=ZERO(B,P)
34400	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
34500		S=E(KK-1)
34600		T=F(LL-1)
34700	9	IF(A-S.LT.X-.01)X=ZERO(A,S)
34800		IF(B-T.LT.Y-.01)Y=ZERO(B,T)
34900		IF(A.GT.B+.01)GO TO 8
35000		B=A
35100		KK=KK+1
35200	62	IF(X.GT.YM)GO TO 5
35300		IF(X.EQ.0)GO TO 27
35400		P=P+SM
35500	25	M=M+1
35600		G(M)=P
35700		GO TO 27
35800	5	P=P+SM
35900		IF(P)GO TO 203
36000	C IF(P)ERROR
36100		IF(P.LT.B-.01)GO TO 5
36200		GO TO 25
36300	8	X=Y
36400		LL=LL+1
36500		GO TO 62
36600	10	M=M+1
36700		G(M)=E(KE)
36800	CC	TYPE 410,(E(K),K=1,KE)
36900	CC	TYPE 410,(F(K),K=1,KF)
37000	CC	TYPE 410,(G(K),K=1,M)
37100	CBCB	WRITE(21,410)(E(K),K=1,KE)
37200	CB	WRITE(21,410)(F(K),K=1,KF)
37300	CB	WRITE(21,410)(G(K),K=1,M)
37400	410	FORMAT(10F7.2)
37500	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
37600	1033	JJ=1
37700		H(1)=0
37800		J=1
37900		K=2
38000		L=2
38100	511	IF(J.EQ.M)GO TO 911
38200		J=J+1
38300		X=G(J)
38400	1211	A=E(K)
38500		B=F(L)
38600		Y=ZERO(X,A)
38700		Z=ZERO(X,B)
38800		IF(A-B.GT..01)GO TO 1111
38900		IF(Y.EQ.0)GO TO 1311
39000		IF(X.LT.A-.01)GO TO 1111
39100		K=K+1
39200	1411	JJ=JJ+1
39300		H(JJ)=-A
39400		GO TO 1211
39500	1111	IF(Z.EQ.0)GO TO 1311
39600		IF(X.LT.B-.01)GO TO 1311
39700		L=L+1
39800		A=B
39900		GO TO 1411
40000	
40100	1311	JJ=JJ+1
40200		H(JJ)=X
40300		IF(Y.EQ.0)GO TO 611
40400		IF(Z.EQ.0)GO TO 711
40500		IF(ZERO(A,B).EQ.0)GO TO 511
40600		P=A
40700		IF(P.GT.B+.01)GO TO 811
40800		IF(P.GT.X+.01)GO TO 511
40900		K=K+1
41000		GO TO 1011
41100	811	P=B
41200		IF(P.GT.X+.01)GO TO 511
41300		L=L+1
41400	1011	JJ=JJ+1
41500		H(JJ)=-P
41600	C NON-SPACED RHYTHS ARE NEG.
41700		GO TO 511
41800	611	K=K+1
41900		IF(Z.GT.0)GO TO 511
42000	711	L=L+1
42100		GO TO 511
42200	911	IF(HH(2).EQ.0)GO TO 2011
42300		K=2
42400		J=2
42500		L=1
42600		HHH(1)=0
42700	1511	IF(J.GT.JJ)GO TO 1811
42800		P=H(J)
42900		A=ABS(P)
43000		B=ABS(HH(K))
43100		IF(ZERO(B,A).EQ.0)GO TO 1611
43200		IF(A.GT.B)GO TO 1711
43300		J=J+1
43400		GO TO 1911
43500	1711	P=HH(K)
43600		GO TO 2211
43700	1611	J=J+1
43800	2211	K=K+1
43900	1911	L=L+1
44000		HHH(L)=P
44100		GO TO 1511
44200	2011	CALL RLOOP(HH,H,JJ)
44300		KL=JJ
44400		GO TO 2111
44500	1811	CALL RLOOP(HH,HHH,L)
44600		KL=L
44700	2111	IF(ST.GE.JPG)GO TO 1333
44800		CALL RLOOP(E,G,M)
44900		KE=M
45000	C GO WAY BACK AND READ ANOTHER LINE.
45100		GO TO 1233
45200	1333	E(1)=0
45300		GO TO 2333
45400		TYPE 410,(HH(K),K=1,KL)
45500		WRITE(21,410)(HH(K),K=1,KL)
45600	2333	JD=1
45700	C JD IS COUNTER FOR DUMMY POSITIONS.
45800		DUMMY(1)=1
45900		ST=0
46000	183	B=0
46100		LL=2
46200	
46300		DO 181 K=1,N
46400		IF(NORH(L))GO TO 181
46500	C LOOK FOR DUMMY RHYTHMS.
46600		IF(L.LE.2)GO TO 2184
46700		RZ=.01
46800	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
46900		GO TO 1184
47000	2184	LF=MM(K)
47100		IF(Q(LF-1).NE.ST)GO TO 181
47200	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
47300		J=6
47400		IF(L.EQ.2)J=4
47500		RZ=Q(LF+J)
47600	1184	B=B+RZ
47700	184	V=ABS(HH(LL))
47800		IF(ZERO(B,V).GT.0)GO TO 182
47900	C FOUND RHYTH MATCH
48000		JD=JD+1
48100		DUMMY(JD)=LL
48200		LL=LL+1
48300		GO TO 181
48400	182	IF(B.LT.V-.01)GO TO 181
48500		LL=LL+1
48600		GO TO 184
48700	181	CONTINUE
48800		ST=ST+1
48900		IF(ST.LT.JPG)GO TO 183
49000	
49100	C NEXT SORT DUMMY ARRAY
49200		J=0
49300	185	DO 186 K=2,JD
49400		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
49500		DO 188 LL=K,JD
49600	188	DUMMY(LL-1)=DUMMY(LL)
49700		JD=JD-1
49800		GO TO 185
49900	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
50000		CALL EXCH(DUMMY(K),DUMMY(K-1))
50100		GO TO 185
50200	186	CONTINUE
50300	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
50400		PX=0
50500		LF=0
50600		K=1
50700		V=0
50800	
50900	81	K=K+1
51000		IF(K.GT.KL)GO TO 1433
51100		B=HH(K)
51200		A=B-V
51300		V=B
51400		IF(V)GO TO 82
51500	85	W=V
51600		IF(A.GT.0.01)GO TO 89
51700	C  .GT. BECAUSE OF ROUND-OFF ERROR
51800		T=5
51900		IF(HH(K+1)-V.LE..01)T=2
52000		PX=PX+T
52100	C THIS FOR BARS, KSIG, METER
52200		GO TO 189
52300	89	PX=PX+PFIB(A)
52400	189	E(K)=PX
52500		IF(LF.NE.0)GO TO 86
52600		GO TO 81
52700	82	LF=K
52800	83	K=K+1
52900		V=HH(K)
53000		IF(V)GO TO 83
53100		A=V-W
53200		GO TO 85
53300	86	LL=LF-1
53400		D=E(K)-E(LL)
53500	87	S=-HH(LF)-HH(LL)
53600		T=HH(K)-HH(LL)
53700		T=S/T
53800	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
53900		E(LF)=E(LL)+D*T
54000		LF=LF+1
54100		IF(LF.NE.K)GO TO 87
54200		LF=0
54300		GO TO 81
54400	
54500	1433	GO TO 2433
54600		TYPE 410,(E(K),K=1,KL)
54700		WRITE(21,410)(E(K),K=1,KL)
54800	C  5 IS SPACE AFTER 1ST BARLINE
54900	2433	R8=RNEXT
55000	C POS OF 1ST BAR = END OF PREV. LINE
55100	     	IF(ENDLN.EQ.0)RNEXT=9
55200	C  MAKES ROOM FOR 1ST CLEF.
55300		KL=KL-1
55400		J=0
55500		R5=0
55600		KK=1
55700		JD=1
55800		W=0
55900		LF=0
56000	
56100		DO 80 K=1,N
56200		IF(NORH(L))GO TO 80
56300		A=Q(MM(K))
56400		IF(ZERO(A,W).EQ.0)GO TO 80
56500	C  SKIP IF SAME POS OF NOTE OR REST.
56600		W=A
56700		R7=R8
56800	190	J=J+1
56900		IF(J.LE.KL)GO TO 290
57000	203	FORMAT(' FOUND CENTERED WHOLE REST!')
57100		LL=0
57200		IF(JCEN.GE.0)GO TO 120
57300		TYPE 203
57400		GO TO 121
57500	120	W=LL
57600		A=0
57700		DO 124 K=1,N
57800		LF=NN(K)
57900		IF(LF.GT.2)GO TO 124
58000		IF(LF.EQ.0)GO TO 124
58100		KE=MM(K)
58200		IF(Q(KE-1).NE.W)GO TO 124
58300	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
58400		JD=6
58500		IF(LF.EQ.2)JD=4
58600		A=A+Q(KE+JD)
58700	124	CONTINUE
58800		TYPE 123,LL,A
58900		LL=LL+1
59000		IF(LL.LT.JPG)GO TO 120
59100	123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
59200	121	PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
59300		GO TO 90
59400	290	IF(DUMMY(JD).NE.J)GO TO 190
59500		JD=JD+1
59600	90 	R8=RNEXT+E(J)
59700		R4=R5
59800		R5=A
59900		X=(R8-R7)/(R5-R4)
60000		S=R7-R4*X
60100		DO 91 L=KK,K
60200		LL=MM(L)
60300	91	Q(LL)=S+X*Q(LL)
60400		KK=K+1
60500	80	CONTINUE
60600	
60700		IF(KK.GT.K)GO TO 180
60800	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
60900		R7=Q(LL)-R5
61000	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
61100		DO 280 L=KK,K
61200		LL=MM(L)
61300	280	Q(LL)=R7+Q(LL)
61400	180	JJ=JJ2-2
61500		L=JJ2
61600		M=0
61700	C FLAG FOR REST AT START OF LINE
61800	
61900		JJJ=-1
62000	C FLAG FOR 1ST BAR OF LINE 12/77
62100		V=0
62200		ACCI=0
62300		DO 12 J=1,JJ
62400		   R=CODEN(KPN,J,Q,LA)
62500	CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
62600		   IF(R.EQ.4)GO TO 680
62700		   IF(M)GO TO 780
62800		   IF(R.NE.2)GO TO 780
62900		   IF(KBR.EQ.0)GO TO 12
63000	C  LOOK FOR RESTS AT FRONT OF LINE.
63100		   X=0
63200		   CALL TURN(J,JJ,1,X)
63300		   PGTRN(KBR)=PGTRN(KBR)+X
63400		   M=-1
63500	780	   IF(R.NE.1)GO TO 12
63600		IF(V.NE.Q(LA+3))GO TO 782
63700		IF(JACC)GO TO 781
63800	782	IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
63900		JACC=-1
64000		ACCI=ACCI+.5
64100		V=Q(LA+3)
64200	781	   M=-1
64300		   IF(NOGRCE)GO TO 12
64400	C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
64500	C FOUND A NOTE
64600		   IF(Q(LA+9).GT.0.05)GO TO 12 
64700	C JUMP IF NOT A GRACE NOTE
64800		   R=Q(LA+2)
64900	C  THE STAFF NUM.
65000		   DO 580 LF=J+1,JJ
65100		   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
65200			IF(Q(JD+2).NE.R)GO TO 580
65300		   	IF(Q(JD).LT.7)GO TO 580
65400		   	IF(Q(JD+9).EQ.0)GO TO 580
65500	C   CHORD NOTE
65600	  	   	R4=Q(LA+3) 
65700	CC	   	R4=Q(LA+3)-1 
65800		   	R5=Q(JD+3)
65900	C  THE STAFF # IS IN R2
66000		   	R8=RSTFAC(IFIX(R2+1))+.5
66100		   	IF(Q(JD+4).LT.80)R8=R8*2  
66200	C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
66300		   	R8=R5-R8
66400	CC	   	R8=R5-R8-1
66500	CCC	   	IF(R4.EQ.R5)GO TO 12
66600		   	IF(R4.NE.R5)GO TO 480
66700	C  GRACE NOTE AT START OF LINE ***** FIX THIS????
66800			DO 880 KE=1,LF-1
66900	880		Q(KPN(KE)+3)=R8
67000	C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
67100		   	GO TO 12
67200	480	   	R2=Q(LA+2)
67300		   	R9=R5
67400		   	CALL PTMOVE(Q,KPN)
67500	CC	   	TYPE 9999,Q(J+3),Q(JD+3)
67600	CC9999	   	FORMAT(2F)
67700		   	GO TO 12 
67800	580	   CONTINUE
67900		   GO TO 12
68000	C  ABOVE FOR GRACE NOTE SPACING.
68100	680	   KBR=KBR+1
68200	C BAR LINE COUNTER
68300		   T=Q(LA+3)
68400	C TOTAL SPACE
68500		   X=0
68600		   CALL TURN(J-1,1,-1,X)
68700		   CALL TURN(J+1,JJ,1,X)
68800	222	   PGTRN(KBR)=X
68900	C FINDS PAGE-TURN POSSIBILITIES
69000	C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
69100		   IF(JJJ)RNEXT=RNEXT-6
69200	C JJJ=-1 IF 1ST BAR OF LINE. 12/77
69300		   JJJ=0
69400		   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
69500	C SIZE OF THIS MEASURE + .5*ACCIDENTALS
69600		ACCI=0
69700		   K=J
69800		   RNEXT=T
69900	12	CONTINUE
70000	
70100		IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
70200		RNEXT=RNEXT+3
70300		JJ2=L 
70400	C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
70500	CC???380	LCNT=0
70600	CC???	NDPY=0
70700	C JJ2 IS END OF PNTR DATA
70800		JPQ=KPN(JJ2-1)+1
70900		CALL PUTEXT(NMPG,'PAG')
71000		CALL EXTOUT(RSTFAC,128)
71100		CALL EXTOUT(PN,JJ2)
71200		CALL EXTOUT(Q,JPQ)
71300		CALL FINEXT
71400	
71500		LASTNM=NMPG
71600		NMPG=NMPG+2
71700		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
71800	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
71900		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
72000		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
72100	122	ENDLN=RNEXT
72200		END